home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
ELECTRIC
/
DSPICE0S.ZIP
/
update.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-22
|
5KB
|
159 lines
/* update.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
lvntmp;
} tabinf_;
#define tabinf_1 tabinf_
struct {
doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
sfactr;
integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
} status_;
#define status_1 status_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/*< subroutine update(vinit,loct,node1,node2,nupda,icheck) >*/
/* Subroutine */ int update_(vinit, loct, node1, node2, nupda, icheck)
doublereal *vinit;
integer *loct, *node1, *node2, *nupda, *icheck;
{
/* System generated locals */
doublereal d_1, d_2;
/* Builtin functions */
double d_sign();
/* Local variables */
static doublereal delv, vlim, vnew;
extern /* Subroutine */ int copy8_();
static doublereal xfact;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
/*< implicit double precision (a-h,o-z) >*/
/* this routine updates and limits the controlling variables for the
*/
/* nonlinear controlled sources. */
/* spice version 2g.6 sccsid=tabinf 3/15/83 */
/*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6 sccsid=status 3/15/83 */
/*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
/*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
/*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/*< go to (40,10,40,20,30,50), initf >*/
switch (status_1.initf) {
case 1: goto L40;
case 2: goto L10;
case 3: goto L40;
case 4: goto L20;
case 5: goto L30;
case 6: goto L50;
}
/*< 10 vnew=vinit >*/
L10:
vnew = *vinit;
/*< go to 70 >*/
goto L70;
/*< 20 vnew=value(lx0+loct) >*/
L20:
vnew = blank_1.value[tabinf_1.lx0 + *loct - 1];
/*< go to 70 >*/
goto L70;
/*< 30 vnew=value(lx1+loct) >*/
L30:
vnew = blank_1.value[tabinf_1.lx1 + *loct - 1];
/*< go to 70 >*/
goto L70;
/*< 40 vnew=value(lvnim1+node1)-value(lvnim1+node2) >*/
L40:
vnew = blank_1.value[tabinf_1.lvnim1 + *node1 - 1] - blank_1.value[
tabinf_1.lvnim1 + *node2 - 1];
/*< go to 60 >*/
goto L60;
/*< 50 call copy8(value(lx1+loct),value(lx0+loct),nupda) >*/
L50:
copy8_(&blank_1.value[tabinf_1.lx1 + *loct - 1], &blank_1.value[
tabinf_1.lx0 + *loct - 1], nupda);
/*< xfact=delta/delold(2) >*/
xfact = status_1.delta / status_1.delold[1];
/*< vnew=(1.0d0+xfact)*value(lx1+loct)-xfact*value(lx2+loct) >*/
vnew = (xfact + 1.) * blank_1.value[tabinf_1.lx1 + *loct - 1] - xfact *
blank_1.value[tabinf_1.lx2 + *loct - 1];
/*< 60 if (dabs(vnew).le.1.0d0) go to 80 >*/
L60:
if (abs(vnew) <= 1.) {
goto L80;
}
/*< delv=vnew-value(lx0+loct) >*/
delv = vnew - blank_1.value[tabinf_1.lx0 + *loct - 1];
/*< if (dabs(delv).le.0.1d0) go to 80 >*/
if (abs(delv) <= .1) {
goto L80;
}
/*< vlim=dmax1(dabs(0.1d0*value(lx0+loct)),0.1d0) >*/
/* Computing MAX */
d_2 = (d_1 = blank_1.value[tabinf_1.lx0 + *loct - 1] * .1, abs(d_1));
vlim = max(.1,d_2);
/*< vnew=value(lx0+loct)+dsign(dmin1(dabs(delv),vlim),delv) >*/
/* Computing MAX */
d_2 = abs(delv);
d_1 = min(vlim,d_2);
vnew = blank_1.value[tabinf_1.lx0 + *loct - 1] + d_sign(&d_1, &delv);
/*< go to 70 >*/
goto L70;
/*< 70 icheck=1 >*/
L70:
*icheck = 1;
/*< 80 value(lx0+loct)=vnew >*/
L80:
blank_1.value[tabinf_1.lx0 + *loct - 1] = vnew;
/*< return >*/
return 0;
/*< end >*/
} /* update_ */
#undef cvalue
#undef nodplc